home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / pctchnqs / 1991 / number4 / generic.mod < prev    next >
Text File  |  1991-06-05  |  4KB  |  154 lines
  1. MODULE Generic;
  2.  
  3. FROM SYSTEM IMPORT
  4.     (*TYPE*)  ADDRESS, BYTE,
  5.     (*PROC*)  ADR;
  6.  
  7. FROM Windows IMPORT
  8. (*TYPE*)  HWND, BOOL, DlgProc, WNDCLASS, HANDLE, LPSTR, MSG,
  9. (*CONST*) True, False, WM_INITDIALOG, WM_COMMAND, IDOK, IDCANCEL,
  10.    WM_DESTROY, NULL, IDC_ARROW, WHITE_BRUSH, WS_OVERLAPPEDWINDOW,
  11.    CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
  12. (*PROC*)  DefWindowProc, EndDialog, MakeDlgProcInstance, DialogBox,
  13.    FreeDlgProcInstance, PostQuitMessage, LoadIcon, LoadCursor,
  14.    GetStockObject, RegisterClass, CreateWindow, ShowWindow,
  15.    UpdateWindow, GetMessage, TranslateMessage, DispatchMessage;
  16.  
  17. CONST
  18.  
  19. (* ID of "About" dialog. Must also define this in resource file. *)
  20.  
  21.   IDM_ABOUT = 100;
  22.  
  23. (* "About" box message processing *)
  24.  
  25. PROCEDURE About ['About'] (        hDlg : HWND;
  26.                            wMsg, wParam : CARDINAL;
  27.                       lParam : LONGINT) : BOOL [WINDOWS, LONG];
  28. BEGIN
  29.     CASE wMsg OF
  30.     WM_INITDIALOG:
  31.         RETURN True;
  32.     |
  33.     WM_COMMAND:
  34.         IF (wParam = IDOK) OR (wParam = IDCANCEL) THEN
  35.             EndDialog(hDlg, True);
  36.             RETURN True;
  37.         END;
  38.     END;
  39.     RETURN False;
  40. END About;
  41.  
  42. (* This is the windows procedure.  Windows automatically calls *)
  43. (* this procedure whenever the window needs repainting, etc.   *)
  44.  
  45. PROCEDURE MainWndProc ['MainWndProc'] (hWnd : HWND;
  46.                                wMsg, wParam : CARDINAL;
  47.                        lParam : LONGINT) : LONGINT [WINDOWS, LONG];
  48. VAR
  49.     lpProcDialog : DlgProc;
  50. BEGIN
  51.     CASE wMsg OF
  52.     WM_COMMAND:
  53.         IF wParam = IDM_ABOUT THEN
  54.           lpProcDialog := MakeDlgProcInstance(About, Instance);
  55.           DialogBox(Instance, ADR('AboutBox'), hWnd, lpProcDialog);
  56.           FreeDlgProcInstance(lpProcDialog);
  57.         ELSE
  58.           RETURN DefWindowProc(hWnd, wMsg, wParam, lParam);
  59.         END;
  60.     |
  61.     WM_DESTROY:
  62.         PostQuitMessage(0);
  63.     ELSE
  64.         RETURN DefWindowProc(hWnd, wMsg, wParam, lParam);
  65.     END;
  66.     RETURN NULL;
  67. END MainWndProc;
  68.  
  69. (* The following application creates the window class shared by
  70. all instances of the program. Several instances might be running
  71. at once, so this procedure is only called by the first to run. *)
  72.  
  73. PROCEDURE InitApplication() : BOOL;
  74. VAR
  75.     Class : WNDCLASS;
  76. BEGIN
  77.     WITH Class DO
  78.         style := NULL;
  79.         lpfnWndProc := MainWndProc;
  80.         cbClsExtra := 0;
  81.         cbWndExtra := 0;
  82.         hInstance := Instance;
  83.         hIcon := LoadIcon(hInstance, ADR('GenericIcon'));
  84.         hCursor := LoadCursor(NULL, IDC_ARROW);
  85.         hbrBackground := GetStockObject(WHITE_BRUSH);
  86.         lpszMenuName := ADR('GenericMenu');
  87.         lpszClassName := ADR('GenericWClass');
  88.     END;
  89.     RETURN RegisterClass(Class);
  90. END InitApplication;
  91.  
  92. (* The following procedure creates the data structures and
  93.    main window for a specific instance of the application. *)
  94.  
  95. PROCEDURE InitInstance() : BOOL;
  96. VAR
  97.     hWnd : HWND;
  98. BEGIN
  99.     hWnd := CreateWindow(
  100.                     ADR('GenericWClass'),
  101.                     ADR('Generic Sample Application'),
  102.                     WS_OVERLAPPEDWINDOW,
  103.                     CW_USEDEFAULT,
  104.                     CW_USEDEFAULT,
  105.                     CW_USEDEFAULT,
  106.                     CW_USEDEFAULT,
  107.                     NULL,
  108.                     NULL,
  109.                     Instance,
  110.                     ADDRESS(0));
  111.  
  112.     IF Instance = NULL THEN
  113.         RETURN False;
  114.     END;
  115.  
  116.     ShowWindow(hWnd, CmdShow);
  117.     UpdateWindow(hWnd);
  118.     RETURN True;
  119. END InitInstance;
  120.  
  121. VAR
  122.     Instance ['SYSTEM_Instance'] : HANDLE;
  123.     PrevInstance ['SYSTEM_PrevInstance'] : HANDLE;
  124.     CmdLine ['SYSTEM_CmdLine'] : LPSTR;
  125.     CmdShow ['SYSTEM_CmdShow'] : INTEGER;
  126.  
  127. VAR
  128.     Msg    : MSG;
  129.  
  130. BEGIN
  131.  
  132. (* Register the window class if we are the first instance to run *)
  133.  
  134.     IF PrevInstance = NULL THEN
  135.         IF InitApplication() = False THEN
  136.             HALT;
  137.         END;
  138.     END;
  139.  
  140.     (* Create the main window *)
  141.  
  142.     IF InitInstance() = False THEN
  143.         HALT;
  144.     END;
  145.  
  146.     LOOP
  147.         IF GetMessage(Msg, NULL, NULL, NULL) = False THEN
  148.             EXIT;
  149.         END;
  150.         TranslateMessage(Msg);
  151.         DispatchMessage(Msg);
  152.     END;
  153. END Generic.
  154.